Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/tbbs/prgsourc.zip/FLAGS.ZIP/FLAG-MGR.PRG

Text File | 1996-03-10 | 19KB | 822 lines

SET EXCLUSIVE ON
SET FORMAT TO fscr NOCLEAR
SET INTENSITY OFF
SET ESCAPE OFF

SELECT a
USE ail INDEX ails

SELECT b
USE vflags INDEX pik


ok = .T.                                         &&  Initialize Variables
STORE " " TO bfil,kin,line,lfil,bpat,dpat,bbsfil,dfil
STORE 0 TO tcnt,dcnt,fcnt,dd,n

DECLARE head[4]                                  && Fill menu arrays
head[1] = " File "
head[2] = " Edit "
head[3] = " Del-by-Date "
head[4] = " Options "

DECLARE file[5]
file[1] = " New ...    "
file[2] = " Open ....  "
file[3] = " Copy ...   "
file[4] = " Delete ... "
file[5] = " Quit       "

DECLARE edit[6]
edit[1] = " Select "
edit[2] = " Cut    "
edit[3] = " Paste  "
edit[4] = " Copy   "
edit[5] = " space "
edit[6] = " graph "

DECLARE ddat[8]
ddat[1] = " 1987   "
ddat[2] = " 1988   "
ddat[3] = " 1989   "
ddat[4] = " 1990   "
ddat[5] = " 1991   "
ddat[6] = " 1992   "
ddat[7] = " 1993   "
ddat[8] = " 1994   "

DECLARE opt[4]
opt[1] =  " lower case & fix... "
opt[2] =  " Do not change case  "
opt[3] =  " Limit lines to...   "
opt[4] =  " Create file list... "

DECLARE fix[4]
fix[1] =  " Cap first letter   "
fix[2] =  " <asp> to <ASP>     "
fix[3] =  " Caps on names      "
fix[4] =  " SHAREWARE and FREE "

@ 0,5 SAY "<A> Block .AIL"
@ 1,5 SAY "<F> View flag positions"
@ 2,5 SAY "<I> Index .TXT file to .PIK file"
@ 3,5 SAY "<L> List files in \PIKS subdirectory"
@ 4,5 SAY "<Esc> Quit"


k= " "
SET COLOR TO N/N
@ 0,0 GET k
DO WHILE .T.
   READ
   DO CASE

      CASE LastKey() = 27
           QUIT

      CASE LastKey() = 65 .OR. LastKey() = 97        && A 0R a .AIL
           @ 0,0 CLEAR
           DO Block
           DO Menu

      CASE LastKey() = 70 .OR. LastKey() = 102       && F 0R f Files
           @ 0,0 CLEAR
           DO Flagview
           DO Menu

      CASE LastKey() = 73 .OR. LastKey() = 105       && I 0R i Index
           @ 0,0 CLEAR
           DO Inx
           DO Menu

      CASE LastKey() = 76 .OR. LastKey() = 108       && L 0R l List files
           @ 0,0 CLEAR
           DO Filelist
           DO Menu



   ENDCASE
ENDDO
QUIT

**************************************************
PROCEDURE Inx

SET COLOR TO W+/N
txt = "textfile"
@ 1,5 SAY "Enter the name of the text file (no path or extension)"
@ 2,5 SAY "to index: "
SET COLOR TO GR+/N
@ 2,15 GET txt PICTURE "@K!"
READ

SET COLOR TO W+/N

SEEK txt
IF .NOT. Found()
   APPEND BLANK
   REPLACE pfile WITH txt
ENDIF

txt = homepath() + "PIKS\" + RTrim(txt) + ".TXT"

b = fMaxLen()
IF b > 5120
   tb = 2048
   pb = 2048
ELSE
   IF buf > 3072
      tb = 1024
      pb = 1024
   ELSE
      IF buf > 512
         tb = 256
         pb = 256
      ELSE
         tb = 0
         pb = 0
      ENDIF
   ENDIF
ENDIF


FOPEN t (txt) 10 tb
IF t < 0
   DO er WITH 1
ENDIF

@ 4,5 SAY "Examining file..."

pmax = 1
lines = 0

DO WHILE .T.
   FLREAD t tm line
   IF tm > 0
      line = LTrim(RTrim(CRTrim(line)))
      n = Len(line)
      IF n = 0
         EXIT
      ENDIF
      IF n > pmax
         pmax = n
      ENDIF
   ELSE
      EXIT
   ENDIF
   lines = lines + 1
ENDDO

@ 6,5 SAY "Number of lines in file:"
SET COLOR TO GR+/N
@ 6,31 SAY LTrim(Str(lines))
SET COLOR TO W+/N

IF lines > 15876
   DO er WITH 2
ENDIF

@ 8,5 SAY "Creating .PIK file..."

txt = Stuff(txt,Len(txt)-2,3,"PIK")

FCREATE p (txt) 13 0 pb
IF p < 0
   DO er WITH 3
ENDIF

FSEEK t tp 0 0

x = 0
DO WHILE .T.
   FLREAD t tm line
   IF tm > 0
      line = LTrim(RTrim(CRTrim(line)))
      p1 = Len(line)
      IF p1 = 0
         EXIT
      ENDIF
      IF pmax = p1
         line = line + Chr(13) + Chr(10)
      ELSE
         line = line + Replicate(Chr(32),pmax-p1) + Chr(13) + Chr(10)
      ENDIF
      p1 = Len(line)
      IF x = 0
         Oldp1 = p1
      ENDIF
      IF p1 # Oldp1
         DO er WITH 4
      ENDIF
      FLWRITE p pm line
      IF pm < 1
         DO er WITH 5
      ENDIF
      x = x + 1
   ELSE
     EXIT
   ENDIF
ENDDO

IF lines # x
   DO er WITH 6
ENDIF

REPLACE plen WITH x
REPLACE pwidth WITH Oldp1

IF x > 126
   REPLACE flen WITH 2
ELSE
   REPLACE flen WITH 1
ENDIF

@ 10,5 SAY "Flag will use"
SET COLOR TO GR+/N
@ 10,19 SAY LTrim(Str(flen))
SET COLOR TO W+/N
IF flen = 1
   @ 10,21 SAY "flag position."
ELSE
   @ 10,21 SAY "flag positions."
ENDIF

@ 11,5 SAY "Enter the initial flag position:"
SET COLOR TO GR+/N
@ 11,38 GET fpos PICTURE "@KZB 99"
READ

FCLOSE p

SET COLOR TO W+/N
@ 13,5 SAY "Flag file indexing completed."
SET COLOR TO GR+/N
@ 14,15 SAY "<ANY KEY>"
k = InKey(40)
RETURN


**************************************************
PROCEDURE Filelist

SET COLOR TO W+/N

mask = HomePath() + "PIKS\*.*"
f1 = FindFirst(fil,(mask))
@ 1,5 SAY f1
x = 1
DO WHILE Len(f1) > 0
   f1 = FindNext(fil)
   @ 1+x,5 SAY f1
   x = x +1
ENDDO

@ Row()+2,5 SAY "<ANY KEY>"
k = Inkey(0)
RETURN


**************************************************
PROCEDURE Flagview

SET COLOR TO W+/N
COUNT TO cnt
GOTO TOP

@ 1,2 SAY  "File/Identifier"
@ 1,22 SAY "F. Position"
@ 1,35 SAY "F. Length"
@ 1,47 SAY "Length of line"
@ 1,62 SAY "Length of File"

x = 1
DO WHILE .T.
   @ x+2,5 SAY pfile
   @ x+2,25 SAY LTrim(Str(fpos))
   @ x+2,37 SAY LTrim(Str(flen))
   @ x+2,49 SAY LTrim(Str(pwidth))
   @ x+2,65 SAY LTrim(Str(plen))
   IF x = cnt
      EXIT
   ENDIF
   SKIP
   x = x + 1
ENDDO

@ Row()+2,5 SAY "<ANY KEY>"
k = Inkey(0)
RETURN


PROCEDURE Block

SELECT a
SET COLOR TO W+/N
COUNT TO cnt
GOTO TOP

@ 1,22 SAY ".AIL File"
@ 1,47 SAY "Blocked"

x = 1
DO WHILE .T.
   @ x+2,25 SAY ail
   IF blocked
      @ x+2,49 SAY "Blocked"
   ELSE
      @ x+2,49 SAY "Open"
   ENDIF
   IF x = cnt
      EXIT
   ENDIF
   SKIP
   x = x + 1
ENDDO
x = 1

GOTO TOP
SET COLOR TO GR+/B
@ x+2,25 SAY ail

k= " "
SET COLOR TO N/N
@ 0,0 GET k
DO WHILE .T.
   READ
   SET COLOR TO W+/N
   DO CASE

      CASE LastKey() = 24                           && Up
           IF x = 1
              LOOP
           ENDIF

           @ x+2,25 SAY ail

           x = x - 1
           SKIP -1

           SET COLOR TO GR+/B
           @ x+2,25 SAY ail


      CASE LastKey() = 24                           && Down
           IF x = cnt
              LOOP
           ENDIF

           @ x+2,25 SAY ail

           x = x + 1
           SKIP

           SET COLOR TO GR+/B
           @ x+2,25 SAY ail


      CASE LastKey() = 27                     && <Esc> =
           EXIT

      CASE LastKey() = 13                     && <Enter> = Block
           IF blocked
              REPLACE blocked WITH .F.
              @ x+2,49 SAY "Open"
           ELSE
              REPLACE blocked WITH .T.
              @ x+2,49 SAY "Blocked"
           ENDIF

   ENDCASE
ENDDO
SELECT b
RETURN


SET COLOR TO B/B
@ 0,0 CLEAR
SET COLOR TO W/W
@ 0,0 CLEAR TO 0,79
@ 24,0 CLEAR TO 24,79
SET COLOR TO N/W
@ 0,10 SAY " Parse "
@ 0,17 SAY " Del-by-Date "
@ 0,30 SAY " Options "
SET COLOR TO W/N
@ 0,4 SAY " File "

SET COLOR TO B/B
@ 7,21 CLEAR TO 16,59

DO WHILE .T.
   DO nLST
   FOPEN lstf (lfil) 10 lbuf                      && Open LIST.LST
   IF lstf < 0
      DO EBox WITH 2
      QUIT
   ENDIF


   x = 1
   y = 4
   r = 1

   DO pBox WITH x

   SET COLOR TO B/B
   @ 22,0 GET kin

   DO WHILE .T.
      READ
      DO CASE
         CASE LastKey() = 19                         && <Lt Arrow>
              r = 1
              p = 1
              d = 1
              o = 1
              SET COLOR TO N/W
              @ 0,y SAY head[x]
              DO clrB WITH x
              IF x = 1
                 x = 4
              ELSE
                 x = x - 1
              ENDIF
              DO CASE
                 CASE x = 1
                      y = 4
                 CASE x = 2
                      y = 10
                 CASE x = 3
                      y = 17
                 CASE x = 4
                      y = 30
              ENDCASE
              DO pBox WITH x
              DO chek WITH x
              SET COLOR TO W/N
              @ 0,y SAY head[x]

         CASE LastKey() = 4                        && <Rt Arrow>
              r = 1
              p = 1
              d = 1
              o = 1
              SET COLOR TO N/W
              @ 0,y SAY head[x]
              DO clrB WITH x
              IF x = 4
                 x = 1
              ELSE
                 x = x + 1
              ENDIF
              DO CASE
                 CASE x = 1
                      y = 4
                 CASE x = 2
                      y = 10
                 CASE x = 3
                      y = 17
                 CASE x = 4
                      y = 30
              ENDCASE
              DO pBox WITH x
              DO chek WITH x
              SET COLOR TO W/N
              @ 0,y SAY head[x]

         CASE LastKey() = 5                        && <Up Arrow>
              SET COLOR TO N/W
              DO CASE
                 CASE x = 1
                      @ r+1,4 SAY file[r]
                      IF r = 1
                         r = 5
                      ELSE
                         r = r - 1
                      ENDIF
                      SET COLOR TO W+/N
                      @ r+1,4 SAY file[r]

                 CASE x = 2
                      @ p+1,12 SAY edit[p]
                      IF p = 1
                         p = 6
                      ELSE
                         p = p - 1
                      ENDIF
                      SET COLOR TO W+/N
                      @ p+1,12 SAY edit[p]

                 CASE x = 3
                      @ d+1,19 SAY ddat[d]
                      IF d = 1
                         d = 8
                      ELSE
                         d = d - 1
                      ENDIF
                      SET COLOR TO W+/N
                      @ d+1,19 SAY ddat[d]

                 CASE x = 4
                      @ o+1,32 SAY opt[o]
                      IF o = 1
                         o = 4
                      ELSE
                         o = o - 1
                      ENDIF
                      SET COLOR TO W+/N
                      @ o+1,32 SAY opt[o]

              ENDCASE

         CASE LastKey() = 24                       && <Dn Arrow>
              SET COLOR TO N/W
              DO CASE
                 CASE x = 1
                      @ r+1,4 SAY file[r]
                      IF r = 5
                         r = 1
                      ELSE
                         r = r + 1
                      ENDIF
                      SET COLOR TO W+/N
                      @ r+1,4 SAY file[r]

                 CASE x = 2
                      @ p+1,12 SAY edit[p]
                      IF p = 6
                         p = 1
                      ELSE
                         p = p + 1
                      ENDIF
                      SET COLOR TO W+/N
                      @ p+1,12 SAY edit[p]

                 CASE x = 3
                      @ d+1,19 SAY ddat[d]
                      IF d = 8
                         d = 1
                      ELSE
                         d = d + 1
                      ENDIF
                      SET COLOR TO W+/N
                      @ d+1,19 SAY ddat[d]

                 CASE x = 4
                      @ o+1,32 SAY opt[o]
                      IF o = 4
                         o = 1
                      ELSE
                         o = o + 1
                      ENDIF
                      SET COLOR TO W+/N
                      @ o+1,32 SAY opt[o]
              ENDCASE

         CASE LastKey() = 13                        && <Enter>
              DO CASE
                 CASE x = 1
                      DO CASE
                         CASE r = 1
                              SET COLOR TO W/N
                              @ 2,4 SAY " Continue   "

                              SET COLOR TO B/B      && Clear Description box
                              @ 9,30 CLEAR TO 13,70

                              SET COLOR TO W+/N
                              @ 2,4 SAY " Continue   "

                         CASE r = 2
                              SET COLOR TO W/N
                              @ 3,4 SAY " Non-Stop   "
                              SET COLOR TO B/B     && Clear Description box
                              @ 9,30 CLEAR TO 13,70

                              SET COLOR TO W+/N
                              @ 3,4 SAY " Non-Stop   "

                         CASE r = 3
                              SET COLOR TO W/N
                              @ 4,4 SAY " Skip       "

                              SET COLOR TO B/B      && Clear Description box
                              @ 9,30 CLEAR TO 13,70

                              SET COLOR TO W+/N
                              @ 4,4 SAY " Skip       "

                         CASE r = 4
                              SET COLOR TO W/N
                              @ 5,4 SAY " New CD-ROM "

                              SET COLOR TO B/B      && Clear Description box
                              @ 9,30 CLEAR TO 13,70
                              EXIT

                         CASE r = 5
                              QUIT
                      ENDCASE

                 CASE x = 2

                 CASE x = 3

                 CASE x = 4

              ENDCASE
         OTHERWISE
             LOOP
      ENDCASE
   ENDDO
ENDDO
QUIT


**************************************************
PROCEDURE pBox
PARAMETERS p

DO CASE
   CASE p = 1                                    && Run
        DO BoxW WITH 1,3,7,16,"s"
        @ 3,4 SAY " Non-Stop   "
        @ 4,4 SAY " Skip       "
        @ 5,4 SAY " New CD-ROM "
        @ 6,4 SAY " Quit       "
        SET COLOR TO W+/N
        @ 2,4 SAY " Continue   "

   CASE p = 2                                    && Parse
        DO BoxW WITH 1,9,8,19,"s"
        @ 3,12 SAY " !!!!! "
        @ 4,12 SAY " ***** "
        @ 5,12 SAY " $$$$$ "
        @ 6,12 SAY " space "
        @ 7,12 SAY " graph "
        SET COLOR TO W+/N
        @ 2,12 SAY " ..... "

   CASE p = 3                                    && Del-by-Date
        DO BoxW WITH 1,16,10,27,"s"
        @ 3,19 SAY " 1988   "
        @ 4,19 SAY " 1989   "
        @ 5,19 SAY " 1990   "
        @ 6,19 SAY " 1991   "
        @ 7,19 SAY " 1992   "
        @ 8,19 SAY " 1993   "
        @ 9,19 SAY " 1994   "
        SET COLOR TO W+/N
        @ 2,19 SAY " 1987   "

   CASE p = 4                                    && Options
        DO BoxW WITH 1,29,6,53,"s"
        @ 3,32 SAY " Do not change case  "
        @ 4,32 SAY " Limit lines to...   "
        @ 5,32 SAY " Create file list... "
        SET COLOR TO W+/N
        @ 2,32 SAY " lower case & fix... "

   CASE p = 5                                    && Fix
        DO BoxW WITH 2,54,7,77,"s"
        @ 4,57 SAY " <asp> to <ASP>     "
        @ 5,57 SAY " Caps on names      "
        @ 6,57 SAY " SHAREWARE and FREE "
        SET COLOR TO W+/N
        @ 3,57 SAY " Cap first letter   "

ENDCASE
RETURN


**************************************************
PROCEDURE chek
PARAMETERS n

SET COLOR TO W+/W
DO CASE
   CASE n = 1
        RETURN
   CASE n = 2
        IF "." $ pstr
           @ 2,11 SAY "√"
        ENDIF
        IF "!" $ pstr
           @ 3,11 SAY "√"
        ENDIF
        IF "*" $ pstr
           @ 4,11 SAY "√"
        ENDIF
        IF "$" $ pstr
           @ 5,11 SAY "√"
        ENDIF
        IF "s" $ pstr
           @ 6,11 SAY "√"
        ENDIF
        IF "g" $ pstr
           @ 7,11 SAY "√"
        ENDIF

   CASE n = 3
        IF "7" $ dstr
           @ 2,18 SAY "√"
        ENDIF
        IF "8" $ dstr
           @ 3,18 SAY "√"
        ENDIF
        IF "9" $ dstr
           @ 4,18 SAY "√"
        ENDIF
        IF "0" $ dstr
           @ 5,18 SAY "√"
        ENDIF
        IF "1" $ dstr
           @ 6,18 SAY "√"
        ENDIF
        IF "2" $ dstr
           @ 7,18 SAY "√"
        ENDIF
        IF "3" $ dstr
           @ 8,18 SAY "√"
        ENDIF
        IF "4" $ dstr
           @ 9,18 SAY "√"
        ENDIF

   CASE n = 4
        IF "l" $ ostr
           @ 2,31 SAY "√"
        ELSE
           @ 3,31 SAY "√"
        ENDIF
        IF "#" $ ostr
           @ 4,31 SAY "√"
        ENDIF
        IF "f" $ ostr
           @ 5,31 SAY "√"
        ENDIF
   CASE n = 5
        IF "f" $ fstr
           @ 3,56 SAY "√"
        ENDIF
        IF "a" $ fstr
           @ 4,56 SAY "√"
        ENDIF
        IF "n" $ fstr
           @ 5,56 SAY "√"
        ENDIF
        IF "u" $ fstr
           @ 6,56 SAY "√"
        ENDIF
ENDCASE
RETURN

**************************************************
PROCEDURE clrB
PARAMETERS n

SET COLOR TO B/B
DO CASE
   CASE n = 1
        @ 1,3 CLEAR TO 8,17
   CASE n = 2
        @ 1,9 CLEAR TO 9,20
   CASE n = 3
        @ 1,16 CLEAR TO 11,28
   CASE n = 4
        @ 1,29 CLEAR TO 7,54
ENDCASE
RETURN



**************************************************
PROCEDURE er
PARAMETERS e

DO CASE
   CASE e = 1
        err = "Error opening .TXT file."
   CASE e = 2
        err = "Maximum 15,876 items in list. List too long."
   CASE e = 3
        err = "Error creating .PIK file."
   CASE e = 4
        err = "Error formatting .PIK file."
   CASE e = 5
        err = "Error writing to .PIK file."
   CASE e = 6
        err = "Error in length of .PIK file."
ENDCASE
SET COLOR TO W+/N
@ 10,5 SAY err
SET COLOR TO GR+/N
@ 11,5 SAY "<ANY KEY>"
k = InKey (30)
QUIT

RETURN